home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1993 July / InfoMagic USENET CD-ROM July 1993.ISO / sources / x / volume2 / emacs.vms / patch1 next >
Encoding:
Internet Message Format  |  1988-12-12  |  56.0 KB
  1. Path: uunet!wyse!mikew
  2. From: mikew@wyse.wyse.com (Mike Wexler)
  3. Newsgroups: comp.sources.x
  4. Subject: v02i042:  Gnu emacs for X/VMS, Patch1
  5. Message-ID: <1895@wyse.wyse.com>
  6. Date: 12 Dec 88 17:38:33 GMT
  7. Organization: Wyse Technology, San Jose
  8. Lines: 1850
  9. Approved: mikew@wyse.com
  10.  
  11. Submitted-by: Joshua Marantz <josh@vx.lcs.mit.edu>
  12. Posting-number: Volume 2, Issue 42
  13. Archive-name: emacs.vms/patch1
  14.  
  15.  
  16. I think that enough people were interested in VMS X11 Gnu Emacs to justify
  17. distribution.  I have given Nelson Beebe full sources to be distributed
  18. from CC.UTAH.EDU.  He may make some announcement about that.  The unix
  19. context diffs, and a vms-compatible version of direx.el are listed below.
  20.  
  21. Make sure you run vms-pp on the unix 18.52 sources before you patch them
  22. with my diffs.  To patch in unix, set up a subdirectory "vmssrc" with
  23. the vms-pp'd unix sources in them, and type "patch -p <vmsemacs.dif".
  24. On VMS, you may be able to apply these patches by hand.  It would be
  25. easier to obtain the full sources (which are a 120k compressed tar file)
  26. from utah.  Other sources (such as the Vax SIG tape) may distribute it
  27. as well.  If anyone wants the full sources mailed directly to them, let
  28. me know.
  29.  
  30. Direx.el is Thomas Lord's (tbl@k.cs.cmu.edu) package for directory editing
  31. without using a subprocess.  It has much of the functionality of dired.
  32. I hacked it to work on VMS.  I suspect that it should still work on Unix,
  33. but I haven't tried it.  I admit I didn't do a very complete job on this,
  34. but it works for all the functions that I use.
  35.  
  36. Good luck.
  37.  
  38. ----------------------Paste into file vmsemacs.dif------------------------
  39. *** unixsrc/dired.c    Tue Dec  6 14:53:13 1988
  40. --- vmssrc/dired.c    Mon Nov 28 15:23:35 1988
  41. ***************
  42. *** 363,368 ****
  43. --- 363,387 ----
  44.           Fcons (make_number (time & 0177777), Qnil));
  45.   }
  46.   
  47. + /* --------Added by Joshua Marantz, Viewlogic Systems Inc, 11/1/88-------- */
  48. + DEFUN ("time-string", Ftime_string, Stime_string, 1, 1, 0,
  49. +   "Convert TIME-LIST, which is a list of the high-order and\n\
  50. + low-order bytes of a Unix time value, to a string.")
  51. +   (time_list)
  52. +     Lisp_Object time_list;
  53. + {
  54. +     Lisp_Object s;
  55. +     long time_val, high, low;
  56. +     char *temp;
  57. + 
  58. +     s = Fcar (time_list);           CHECK_NUMBER (s, 3);  high = XFASTINT (s);
  59. +     s = Fcar (Fcdr (time_list));    CHECK_NUMBER (s, 3);  low =  XFASTINT (s);
  60. +     time_val = (high << 16) | low;
  61. +     temp = (char *) ctime (&time_val);
  62. +     return (build_string (temp));
  63. + }
  64. + 
  65. + 
  66.   DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 1, 0,
  67.     "Return a list of attributes of file FILENAME.\n\
  68.   Value is nil if specified file cannot be opened.\n\
  69. ***************
  70. *** 445,450 ****
  71. --- 464,472 ----
  72.   #endif /* VMS */
  73.     defsubr (&Sfile_name_all_completions);
  74.     defsubr (&Sfile_attributes);
  75. + 
  76. + /* --------Added by Joshua Marantz, Viewlogic Systems Inc, 11/1/88-------- */
  77. +   defsubr (&Stime_string);
  78.   
  79.   #ifdef VMS
  80.     Qcompletion_ignore_case = intern ("completion-ignore-case");
  81. *** unixsrc/keyboard.c    Tue Dec  6 14:53:18 1988
  82. --- vmssrc/keyboard.c    Mon Nov 28 15:23:35 1988
  83. ***************
  84. *** 992,997 ****
  85. --- 992,1005 ----
  86.        int *addr;
  87.   {
  88.   #ifdef VMS
  89. + 
  90. + /* --------Added by Joshua Marantz, Viewlogic Systems Inc, 11/1/88-------- */
  91. + #ifdef HAVE_X_WINDOWS
  92. +     extern int XTclear_screen ();
  93. +     if (clear_screen_hook == XTclear_screen)
  94. +         XTprocess_window_events ();
  95. + #endif
  96. + 
  97.     /* On VMS, we always have something in the buffer
  98.        if any input is available.  */
  99.     /*** It might be simpler to make interrupt_input 1 on VMS ***/
  100. *** unixsrc/sysdep.c    Tue Dec  6 14:53:25 1988
  101. --- vmssrc/sysdep.c    Mon Nov 28 15:23:36 1988
  102. ***************
  103. *** 19,24 ****
  104. --- 19,36 ----
  105.   and this notice must be preserved on all copies.  */
  106.   
  107.   
  108. + /*
  109. + This file has been heavily modified so that it can work under X11 and
  110. + VMS (using DECwindows).  All the changes conditionalize various things
  111. + between the terminal and DECwindows, using the preprocessor macro
  112. + VMS_X11.  Search for that and you will find all the changes.
  113. + 
  114. +                     Joshua Marantz
  115. +                     Viewlogic Systems, Inc.
  116. +                     (508) 480-0881
  117. +                     josh@vx.lcs.mit.edu
  118. + */
  119. + 
  120.   #include <signal.h>
  121.   #include <setjmp.h>
  122.   
  123. ***************
  124. *** 85,92 ****
  125.   #include <rab.h>
  126.   #endif
  127.   #define    MAXIOSIZE ( 32 * PAGESIZE )    /* Don't I/O more than 32 blocks at a time */
  128. - #endif /* VMS */
  129.   
  130.   #ifndef BSD4_1
  131.   #ifdef BSD /* this is done this way to avoid defined(BSD) || defined (USG)
  132.             because the vms compiler doesn't grok `defined' */
  133. --- 97,128 ----
  134.   #include <rab.h>
  135.   #endif
  136.   #define    MAXIOSIZE ( 32 * PAGESIZE )    /* Don't I/O more than 32 blocks at a time */
  137.   
  138. + /* ---------------------Preprocessor black magic!!----------------------------
  139. +    Define a macro that will perform some action if we are currently running
  140. +    under X11 on VMS.  The critical thing is that the action must not be
  141. +    compiled in unless Emacs is compiled for VMS/X windows, because other
  142. +    VMS users may not be able to link against the DECwindows libraries.
  143. +    On the other hand, just because you've compiled for X windows on VMS
  144. +    doesn't mean you are running it that way on every invocation.  So if
  145. +    we are compiling for X, we use a real if statement, leaving the else
  146. +    clause free.  If we are not, then we do not even reference the action.
  147. +                 -Joshua Marantz,
  148. +         Viewlogic Systems Inc.
  149. +         11/1/88
  150. + */
  151. + #ifdef HAVE_X_WINDOWS
  152. + extern int XTclear_screen ();
  153. + #define IF_VMS_X11(action) if (clear_screen_hook == XTclear_screen) action
  154. + #define IF_NOT_VMS_X11() if (clear_screen_hook != XTclear_screen)
  155. + #else
  156. + #define IF_VMS_X11(action) if (0)
  157. + #define IF_NOT_VMS_X11()
  158. + #endif
  159. + 
  160. + #else /* VMS */
  161. + #endif /* not VMS */
  162. + 
  163.   #ifndef BSD4_1
  164.   #ifdef BSD /* this is done this way to avoid defined(BSD) || defined (USG)
  165.             because the vms compiler doesn't grok `defined' */
  166. ***************
  167. *** 265,274 ****
  168.       return;
  169.   
  170.   #ifdef VMS
  171. !   end_kbd_input ();
  172. !   SYS$QIOW (0, input_chan, IO$_READVBLK|IO$M_PURGE, input_iosb, 0, 0,
  173. !         &buf, 0, 0, terminator_mask, 0, 0);
  174. !   queue_kbd_input ();
  175.   #else /* not VMS */
  176.     ioctl (0, TIOCGETP, &buf);
  177.     ioctl (0, TIOCSETP, &buf);
  178. --- 301,313 ----
  179.       return;
  180.   
  181.   #ifdef VMS
  182. !   IF_VMS_X11 (XTdiscard_input ());
  183. !   else {
  184. !       end_kbd_input ();
  185. !       SYS$QIOW (0, input_chan, IO$_READVBLK|IO$M_PURGE, input_iosb, 0, 0,
  186. !         &buf, 0, 0, terminator_mask, 0, 0);
  187. !       queue_kbd_input ();
  188. !   }
  189.   #else /* not VMS */
  190.     ioctl (0, TIOCGETP, &buf);
  191.     ioctl (0, TIOCSETP, &buf);
  192. ***************
  193. *** 299,306 ****
  194.     else
  195.       {
  196.   #ifdef VMS
  197. !       SYS$QIOW (0, input_chan, IO$_SENSEMODE, &sg, 0, 0,
  198. !         &sg.class, 12, 0, 0, 0, 0 );
  199.   #else
  200.         SETOSPEED (sg, B9600);
  201.         ioctl (0, TIOCGETP, &sg);
  202. --- 338,346 ----
  203.     else
  204.       {
  205.   #ifdef VMS
  206. !     IF_NOT_VMS_X11 ()
  207. !         SYS$QIOW (0, input_chan, IO$_SENSEMODE, &sg, 0, 0,
  208. !               &sg.class, 12, 0, 0, 0, 0 );
  209.   #else
  210.         SETOSPEED (sg, B9600);
  211.         ioctl (0, TIOCGETP, &sg);
  212. ***************
  213. *** 509,514 ****
  214. --- 549,555 ----
  215.   #ifdef VMS
  216.     unsigned long parent_id;
  217.   
  218. +   IF_VMS_X11 (return (-1));
  219.     parent_id = getppid ();
  220.     if (parent_id && parent_id != 0xffffffff)
  221.       {
  222. ***************
  223. *** 744,751 ****
  224.       ((unsigned) 1 << (process_ef % 32));
  225.     timer_eflist = ((unsigned) 1 << (input_ef % 32)) |
  226.       ((unsigned) 1 << (timer_ef % 32));
  227. !   SYS$QIOW (0, input_chan, IO$_SENSEMODE, &old_gtty, 0, 0,
  228. !         &old_gtty.class, 12, 0, 0, 0, 0);
  229.   #ifndef VMS4_4
  230.     sys_access_reinit ();
  231.   #endif
  232. --- 785,794 ----
  233.       ((unsigned) 1 << (process_ef % 32));
  234.     timer_eflist = ((unsigned) 1 << (input_ef % 32)) |
  235.       ((unsigned) 1 << (timer_ef % 32));
  236. !   IF_VMS_X11 (XTinit_vms_input (input_ef));
  237. !   else
  238. !       SYS$QIOW (0, input_chan, IO$_SENSEMODE, &old_gtty, 0, 0,
  239. !         &old_gtty.class, 12, 0, 0, 0, 0);
  240.   #ifndef VMS4_4
  241.     sys_access_reinit ();
  242.   #endif
  243. ***************
  244. *** 811,818 ****
  245.   #endif /* not HAVE_TERMIO */
  246.   
  247.   #ifdef VMS
  248. !       SYS$QIOW (0, input_chan, IO$_SETMODE, &input_iosb, 0, 0,
  249. !         &sg.class, 12, 0, 0, 0, 0);
  250.   #else
  251.         ioctl (0, TIOCSETN, &sg);
  252.   #endif /* not VMS */
  253. --- 854,862 ----
  254.   #endif /* not HAVE_TERMIO */
  255.   
  256.   #ifdef VMS
  257. !       IF_NOT_VMS_X11 ()
  258. !       SYS$QIOW (0, input_chan, IO$_SETMODE, &input_iosb, 0, 0,
  259. !             &sg.class, 12, 0, 0, 0, 0);
  260.   #else
  261.         ioctl (0, TIOCSETN, &sg);
  262.   #endif /* not VMS */
  263. ***************
  264. *** 885,891 ****
  265.         SYS$QIOW (0, input_chan, IO$_SETMODE|IO$M_OUTBAND, 0, 0, 0,
  266.           interrupt_signal, oob_chars, 0, 0, 0, 0);
  267.   */
  268. !       queue_kbd_input (0);
  269.   #endif /* VMS */
  270.       }
  271.   #ifdef VMS  /* VMS sometimes has this symbol but lacks setvbuf.  */
  272. --- 929,936 ----
  273.         SYS$QIOW (0, input_chan, IO$_SETMODE|IO$M_OUTBAND, 0, 0, 0,
  274.           interrupt_signal, oob_chars, 0, 0, 0, 0);
  275.   */
  276. !       IF_NOT_VMS_X11 ()
  277. !       queue_kbd_input (0);
  278.   #endif /* VMS */
  279.       }
  280.   #ifdef VMS  /* VMS sometimes has this symbol but lacks setvbuf.  */
  281. ***************
  282. *** 921,926 ****
  283. --- 966,972 ----
  284.     if (noninteractive)
  285.       return 1;
  286.   #ifdef VMS
  287. +   IF_VMS_X11 (return (1));
  288.     SYS$QIOW (0, input_chan, IO$_SENSEMODE, &sg, 0, 0,
  289.           &sg.class, 12, 0, 0, 0, 0);
  290.   #else
  291. ***************
  292. *** 962,971 ****
  293.   #else /* not TIOCGWNSIZ */
  294.   #ifdef VMS
  295.     TERMINAL sg;
  296. !   SYS$QIOW (0, input_chan, IO$_SENSEMODE, &sg, 0, 0,
  297. !         &sg.class, 12, 0, 0, 0, 0);
  298. !   *widthp = sg.scr_wid;
  299. !   *heightp = sg.scr_len;
  300.   #else /* system doesn't know size */
  301.     *widthp = 0;
  302.     *heightp = 0;
  303. --- 1008,1020 ----
  304.   #else /* not TIOCGWNSIZ */
  305.   #ifdef VMS
  306.     TERMINAL sg;
  307. !   IF_VMS_X11 (*widthp = *heightp = 0);
  308. !   else {
  309. !       SYS$QIOW (0, input_chan, IO$_SENSEMODE, &sg, 0, 0,
  310. !         &sg.class, 12, 0, 0, 0, 0);
  311. !       *widthp = sg.scr_wid;
  312. !       *heightp = sg.scr_len;
  313. !   }
  314.   #else /* system doesn't know size */
  315.     *widthp = 0;
  316.     *heightp = 0;
  317. ***************
  318. *** 1019,1027 ****
  319.       reset_sigio ();
  320.   #endif /* BSD4_1 */
  321.   #ifdef VMS
  322. !   end_kbd_input ();
  323. !   SYS$QIOW (0, input_chan, IO$_SETMODE, &input_iosb, 0, 0,
  324. !         &old_gtty.class, 12, 0, 0, 0, 0);
  325.   #else /* not VMS */
  326.     while (ioctl (0, TCSETAW, &old_gtty) < 0 && errno == EINTR);
  327.   #endif /* not VMS */
  328. --- 1068,1078 ----
  329.       reset_sigio ();
  330.   #endif /* BSD4_1 */
  331.   #ifdef VMS
  332. !   IF_NOT_VMS_X11 () {
  333. !       end_kbd_input ();
  334. !       SYS$QIOW (0, input_chan, IO$_SETMODE, &input_iosb, 0, 0,
  335. !         &old_gtty.class, 12, 0, 0, 0, 0);
  336. !   }
  337.   #else /* not VMS */
  338.     while (ioctl (0, TCSETAW, &old_gtty) < 0 && errno == EINTR);
  339.   #endif /* not VMS */
  340. ***************
  341. *** 1035,1052 ****
  342.   
  343.   /* Assigning an input channel is done at the start of Emacs execution.
  344.      This is called each time Emacs is resumed, also, but does nothing
  345. !    because input_chain is no longer zero.  */
  346.   
  347.   init_vms_input()
  348.   {
  349.     int status;
  350.     
  351. !   if (input_chan == 0)
  352. !     {
  353. !       status = SYS$ASSIGN (&input_dsc, &input_chan, 0, 0);
  354. !       if (! (status & 1))
  355. !     LIB$STOP (status);
  356. !     }
  357.   }
  358.   
  359.   /* Deassigning the input channel is done before exiting.  */
  360. --- 1086,1104 ----
  361.   
  362.   /* Assigning an input channel is done at the start of Emacs execution.
  363.      This is called each time Emacs is resumed, also, but does nothing
  364. !    because input_chan is no longer zero.  */
  365.   
  366.   init_vms_input()
  367.   {
  368.     int status;
  369.     
  370. !   if (input_chan == 0) {
  371. !       IF_NOT_VMS_X11 () {
  372. !       status = SYS$ASSIGN (&input_dsc, &input_chan, 0, 0);
  373. !       if (! (status & 1))
  374. !           LIB$STOP (status);
  375. !       }
  376. !   }
  377.   }
  378.   
  379.   /* Deassigning the input channel is done before exiting.  */
  380. ***************
  381. *** 1053,1059 ****
  382.   
  383.   stop_vms_input ()
  384.   {
  385. !   return SYS$DASSGN (input_chan);
  386.   }
  387.   
  388.   short input_buffer;
  389. --- 1105,1112 ----
  390.   
  391.   stop_vms_input ()
  392.   {
  393. !     IF_NOT_VMS_X11 ()
  394. !     return SYS$DASSGN (input_chan);
  395.   }
  396.   
  397.   short input_buffer;
  398. ***************
  399. *** 1115,1154 ****
  400.   
  401.   /* Wait until there is something in kbd_buffer.  */
  402.   
  403. ! wait_for_kbd_input ()
  404. ! {
  405. !   extern int have_process_input, process_exited;
  406.   
  407. !   /* If already something, avoid doing system calls.  */
  408. !   if (detect_input_pending ())
  409. !     {
  410. !       return;
  411. !     }
  412. !   /* Clear a flag, and tell ast routine above to set it.  */
  413. !   SYS$CLREF (input_ef);
  414. !   waiting_for_ast = 1;
  415. !   /* Check for timing error: ast happened while we were doing that.  */
  416. !   if (!detect_input_pending ())
  417. !     {
  418. !       /* No timing error: wait for flag to be set.  */
  419. !       SYS$WFLOR (input_ef, input_eflist);
  420. !       if (!detect_input_pending ())
  421. !     /* Check for subprocess input availability */
  422. !     {
  423. !       int dsp = have_process_input || process_exited;
  424.   
  425. !       if (have_process_input)
  426. !         process_command_input ();
  427. !       if (process_exited)
  428. !         process_exit ();
  429. !       if (dsp)
  430. !         {
  431. !           RedoModes++;
  432. !           DoDsp (1);
  433.           }
  434.       }
  435.       }
  436. -   waiting_for_ast = 0;
  437.   }
  438.   
  439.   /* Get rid of any pending QIO, when we are about to suspend
  440. --- 1168,1212 ----
  441.   
  442.   /* Wait until there is something in kbd_buffer.  */
  443.   
  444. ! /* --------Added by Joshua Marantz, Viewlogic Systems Inc, 11/1/88--------
  445. !    This routine was changed to use a while loop so that X11 window events,
  446. !    such as exposure and resizing, would be handled better.  Under the old
  447. !    method, which used an "if" instead of a "while", window events would
  448. !    not be handled until the next keyboard event.
  449. ! */
  450. ! wait_for_kbd_input () {
  451. !     extern int have_process_input, process_exited;
  452.   
  453. !     /* If already something, avoid doing system calls.  */
  454. !     while (!detect_input_pending ()) {
  455.   
  456. !     /* Clear a flag, and tell ast routine above to set it.  */
  457. !     SYS$CLREF (input_ef);
  458. !     waiting_for_ast = 1;
  459. ! 
  460. !     /* Check for timing error: ast happened while we were doing that.  */
  461. !     if (!detect_input_pending ()) {
  462. !         /* No timing error: wait for flag to be set.  */
  463. !         SYS$WFLOR (input_ef, input_eflist);
  464. !         if (!detect_input_pending ()) {
  465. ! 
  466. !         /* Check for subprocess input availability */
  467. !         int dsp = have_process_input || process_exited;
  468. ! 
  469. !         if (have_process_input)
  470. !             process_command_input ();
  471. !         if (process_exited)
  472. !             process_exit ();
  473. !         if (dsp) {
  474. !             RedoModes++;
  475. !             DoDsp (1);
  476. !         }
  477. ! 
  478. !         IF_VMS_X11 (XTprocess_window_events ());
  479.           }
  480.       }
  481. +     waiting_for_ast = 0;
  482.       }
  483.   }
  484.   
  485.   /* Get rid of any pending QIO, when we are about to suspend
  486. ***************
  487. *** 2737,2742 ****
  488. --- 2795,2801 ----
  489.     return pathname;
  490.   }
  491.   
  492. + #ifndef VMS5_0
  493.   getppid ()
  494.   {
  495.     long item_code = JPI$_OWNER;
  496. ***************
  497. *** 2751,2756 ****
  498. --- 2810,2816 ----
  499.       }
  500.     return parent_id;
  501.   }
  502. + #endif
  503.   
  504.   #ifdef getuid
  505.   #undef getuid
  506. *** unixsrc/x11fns.c    Tue Dec  6 14:53:28 1988
  507. --- vmssrc/x11fns.c    Mon Nov 28 15:23:36 1988
  508. ***************
  509. *** 40,46 ****
  510.   #else
  511.   #include <sys/time.h>
  512.   #endif
  513. ! #include <fcntl.h>
  514.   #include <setjmp.h>
  515.   
  516.   #ifdef HAVE_X_WINDOWS
  517. --- 40,46 ----
  518.   #else
  519.   #include <sys/time.h>
  520.   #endif
  521. ! /* #include <fcntl.h> --------Commented out 11/1/88, Joshua Marantz--------*/
  522.   #include <setjmp.h>
  523.   
  524.   #ifdef HAVE_X_WINDOWS
  525. *** unixsrc/x11term.c    Tue Dec  6 14:53:32 1988
  526. --- vmssrc/x11term.c    Mon Nov 28 15:23:37 1988
  527. ***************
  528. *** 21,27 ****
  529. --- 21,53 ----
  530.   /* Written by Yakim Martillo, mods and things by Robert Krawitz  */
  531.   /* Redone for X11 by Robert French */
  532.   /* Thanks to Mark Biggers for all of the Window Manager support */
  533. + /*
  534.   
  535. + Heavily #ifdefd to support VAX/VMS.  A better X11 implementation would
  536. + have been portable between operating systems.  Unfortunately, the
  537. + original Unix implementation depends too much on Unix signals to
  538. + implement detection of Control-G interrupts and window events.  The
  539. + easiest way to get this to work under VMS was to use the DECwindows
  540. + asynchronous event notification support to hook into the existing AST
  541. + support for terminal I/O.  The same event flag is used, and it appears
  542. + to work well.  The cost is portability between X on different
  543. + operating systems.  The benefits on VMS, however, are many: The screen
  544. + refresh speed much greater than that in a terminal emulator window.
  545. + The Compose key functions as a Meta key.  And you can resize an Emacs
  546. + in progress, without having to suspend and resume.  Another difference
  547. + between VMS and Unix is that the DECwindows window manager supports
  548. + focus-based (click-to-type) keyboard management, and so the
  549. + solid/hollow cursor is based on focus notification instead of
  550. + enter/leave events.
  551. + 
  552. + Look for #ifdef/#ifndef VMS to spot all the differences.
  553. + 
  554. +                     Joshua Marantz
  555. +                     Viewlogic Systems, Inc.
  556. +                     (508) 480-0881
  557. +                     josh@vx.lcs.mit.edu
  558. + */
  559. + 
  560.   /*
  561.    *    $Source: /mit/emacs/src/RCS/11xterm.c,v $
  562.    *    $Author: rfrench $
  563. ***************
  564. *** 82,88 ****
  565.   #include <sys/time.h>
  566.   #endif
  567.   
  568. ! #include <fcntl.h>
  569.   #include <stdio.h>
  570.   #include <ctype.h>
  571.   #include <errno.h>
  572. --- 108,114 ----
  573.   #include <sys/time.h>
  574.   #endif
  575.   
  576. ! /* #include <fcntl.h> */
  577.   #include <stdio.h>
  578.   #include <ctype.h>
  579.   #include <errno.h>
  580. ***************
  581. *** 609,615 ****
  582. --- 635,643 ----
  583.   XTflash ()
  584.   {
  585.       XGCValues gcv_temp;
  586. + #ifndef VMS
  587.       struct timeval to;
  588. + #endif
  589.       BLOCK_INPUT_DECLARE ();
  590.   
  591.   #ifdef XDEBUG
  592. ***************
  593. *** 627,640 ****
  594.                  screen_height*XXfonth+2*XXInternalBorder);
  595.       XFlush (XXdisplay);
  596.   
  597.       UNBLOCK_INPUT ();
  598. - 
  599.       to.tv_sec = 0;
  600.       to.tv_usec = 250000;
  601. -     
  602.       select(0, 0, 0, 0, &to);
  603.       
  604.       BLOCK_INPUT ();
  605.   
  606.       XFillRectangle (XXdisplay, XXwindow, XXgc_temp, 0, 0,
  607.               screen_width*XXfontw+2*XXInternalBorder,
  608. --- 655,672 ----
  609.                  screen_height*XXfonth+2*XXInternalBorder);
  610.       XFlush (XXdisplay);
  611.   
  612. + #ifdef VMS
  613. +     /* this routine really should have better granularity so we can
  614. +        do .25 seconds just like the big boys from Unix can! */
  615. +     input_wait_timeout (1);
  616. + #else
  617.       UNBLOCK_INPUT ();
  618.       to.tv_sec = 0;
  619.       to.tv_usec = 250000;
  620.       select(0, 0, 0, 0, &to);
  621.       
  622.       BLOCK_INPUT ();
  623. + #endif
  624.   
  625.       XFillRectangle (XXdisplay, XXwindow, XXgc_temp, 0, 0,
  626.               screen_width*XXfontw+2*XXInternalBorder,
  627. ***************
  628. *** 1039,1044 ****
  629. --- 1071,1077 ----
  630.       }
  631.   }
  632.       
  633. + #ifndef VMS
  634.   /* Substitutes for standard read routine.  Under X not interested in individual
  635.    * bytes but rather individual packets.
  636.    */
  637. ***************
  638. *** 1054,1059 ****
  639. --- 1087,1093 ----
  640.   
  641.       return (internal_socket_read (bufp, numchars));
  642.   }
  643. + #endif /* not VMS */
  644.   
  645.   /*
  646.    * Interpreting incoming keycodes. Should have table modifiable as needed
  647. ***************
  648. *** 1211,1216 ****
  649. --- 1245,1251 ----
  650.   }
  651.   #endif /* not sun */
  652.       
  653. + #ifndef VMS
  654.   internal_socket_read(bufp, numchars)
  655.       register unsigned char *bufp;
  656.       register int numchars;
  657. ***************
  658. *** 1399,1404 ****
  659. --- 1434,1440 ----
  660.     UNBLOCK_INPUT ();
  661.     return count;
  662.   }
  663. + #endif /* not VMS */
  664.   
  665.   /* Exit gracefully from gnuemacs, doing an autosave and giving a status.
  666.    */
  667. ***************
  668. *** 1416,1421 ****
  669. --- 1452,1458 ----
  670.   
  671.   xfixscreen ()
  672.   {
  673. + #ifndef VMS
  674.       BLOCK_INPUT_DECLARE ();
  675.   
  676.       /* Yes, this is really what I mean -- Check to see if we've
  677. ***************
  678. *** 1432,1437 ****
  679. --- 1469,1475 ----
  680.           CursorToggle ();
  681.   
  682.       UNBLOCK_INPUT ();
  683. + #endif
  684.   }
  685.       
  686.   
  687. ***************
  688. *** 1538,1544 ****
  689. --- 1576,1584 ----
  690.       update_begin_hook = XTupdate_begin;
  691.       update_end_hook = XTupdate_end;
  692.       set_terminal_window_hook = XTset_terminal_window;
  693. + #ifndef VMS
  694.       read_socket_hook = XTread_socket;
  695. + #endif
  696.       topos_hook = XTtopos;
  697.       reassert_line_highlight_hook = XTreassert_line_highlight;
  698.       scroll_region_ok = 1;    /* we'll scroll partial screens */
  699. ***************
  700. *** 1575,1583 ****
  701. --- 1615,1637 ----
  702.       XXicon_usebitmap = 0;
  703.       
  704.       temp_font = "fixed";
  705. + 
  706. + /* ------Joshua Marantz 11/1/88, argv[0] on VMS contains full pathname------*/
  707. + #ifdef VMS
  708.       progname = xargv[0];
  709. +     if (ptr = rindex(progname, ']'))
  710. +       progname = ptr+1;
  711. +     ptr = progname;
  712. +     progname = xmalloc (strlen (ptr) + 1);
  713. +     strcpy (progname, ptr);
  714. +     if (ptr = rindex (progname, '.'))
  715. +         *ptr = 0;
  716. + #else
  717. +     progname = xargv[0];
  718.       if (ptr = rindex(progname, '/'))
  719.         progname = ptr+1;
  720. + #endif
  721. + 
  722.       XXpid = getpid ();
  723.       default_window = "=80x24+0+0";
  724.   
  725. ***************
  726. *** 2056,2061 ****
  727. --- 2110,2131 ----
  728.   }
  729.   
  730.   
  731. + #ifdef VMS
  732. + static void gethostname(buf, len)
  733. +     char *buf;
  734. +     int len;
  735. + {
  736. +     char *s;
  737. +     s = getenv ("SYS$NODE");
  738. +     if (s == NULL)
  739. +         buf[0] = '\0';
  740. +     else {
  741. +         strncpy (buf, s, len - 2);
  742. +         buf[len - 1] = '\0';
  743. +     } /* else */
  744. + } /* static void gethostname */
  745. + #endif
  746. + 
  747.   /* ------------------------------------------------------------
  748.    */
  749.   static char  hostname[100];
  750. ***************
  751. *** 2356,2367 ****
  752.   
  753.       XSelectInput(XXdisplay, XXwindow, KeyPressMask |
  754.            ExposureMask | ButtonPressMask | ButtonReleaseMask |
  755. !          EnterWindowMask | LeaveWindowMask |
  756.            StructureNotifyMask);
  757.   
  758.       XMapWindow (XXdisplay, XXwindow);
  759.       XFlush (XXdisplay);
  760.   }
  761.   
  762.   #endif /* HAVE_X_WINDOWS */
  763.   
  764. --- 2426,2614 ----
  765.   
  766.       XSelectInput(XXdisplay, XXwindow, KeyPressMask |
  767.            ExposureMask | ButtonPressMask | ButtonReleaseMask |
  768. !          EnterWindowMask | LeaveWindowMask | FocusChangeMask |
  769.            StructureNotifyMask);
  770.   
  771.       XMapWindow (XXdisplay, XXwindow);
  772.       XFlush (XXdisplay);
  773.   }
  774. + 
  775. + #ifdef VMS
  776. + /* The VMS routines in SYSDEP.C use event flags to determine if the user
  777. +    hit the key during a timer run.  Fortunately, DECwindows supplies AST
  778. +    notification capability to X events, so we can set the AST that way. */
  779. + extern int waiting_for_ast;
  780. + static int input_ast(input_ef)
  781. +     int input_ef;
  782. + {
  783. +     XEvent event;
  784. +     int nbytes, i;
  785. +     char mapping_buf[20];
  786. +     KeySym keysym;
  787. +     XComposeStatus status;
  788. + 
  789. +     if (waiting_for_ast)
  790. +     SYS$SETEF (input_ef);
  791. +     waiting_for_ast = 0;
  792. + 
  793. +     while (XCheckMaskEvent (XXdisplay, KeyPressMask | ButtonPressMask |
  794. +                 ButtonReleaseMask, &event))
  795. +     {
  796. +     switch (event.type) {
  797. +       case KeyPress:
  798. +         /* Someday this will be unnecessary as we will
  799. +            be able to use XRebindKeysym so XLookupString
  800. +            will have always give us the string we want. */
  801. +         nbytes = 1;
  802. +         keysym = XKeycodeToKeysym (XXdisplay, event.xkey.keycode, 0);
  803. + 
  804. + #define CTRL(c) (c - 64)
  805. + #define META(c) (c + 128)
  806. + #define STUFF(c) *mapping_buf = c; break;
  807. + 
  808. +         switch (keysym) {
  809. +         case XK_Left:    STUFF (CTRL ('B'));
  810. +         case XK_Right:   STUFF (CTRL ('F'));
  811. +         case XK_Up:      STUFF (CTRL ('P'));
  812. +         case XK_Down:    STUFF (CTRL ('N'));
  813. +         case XK_Prior:   STUFF (META ('V'));
  814. +         case XK_Next:    STUFF (CTRL ('V'));
  815. +         case XK_Insert:  STUFF (CTRL ('Y'));
  816. +         case DXK_Remove: STUFF (CTRL ('W'));
  817. +         case XK_Find:    STUFF (CTRL ('S'));
  818. +         case XK_Select:  STUFF (CTRL ('@'));
  819. +         case XK_Help:    STUFF (CTRL ('H'));
  820. +         case XK_Execute: STUFF (CTRL ('\\'));
  821. +         default:
  822. +             if (IsFunctionKey (keysym) || IsMiscFunctionKey (keysym)) {
  823. +             strcpy (mapping_buf, "[");
  824. +             strcat (mapping_buf, stringFuncVal (keysym));
  825. +             strcat (mapping_buf, "~");
  826. +             nbytes = strlen (mapping_buf);
  827. +             }
  828. +             else
  829. +             nbytes = XLookupString (&event, mapping_buf, 20,
  830. +                         &keysym, &status);
  831. +         } /* switch */
  832. +         if (nbytes > 0) {
  833. +         if (event.xkey.state & Mod1Mask)
  834. +             *mapping_buf |= METABIT;
  835. +         for (i = 0; i < nbytes; i++)
  836. +             kbd_buffer_store_char (mapping_buf[i]);
  837. +         }
  838. +         break;
  839. + 
  840. +       case ButtonPress:
  841. +       case ButtonRelease:
  842. +         kbd_buffer_store_char ('X' & 037);
  843. +         kbd_buffer_store_char ('@' & 037);
  844. +         if (XXm_queue_num == XMOUSEBUFSIZE)
  845. +           break;
  846. +         XXm_queue[XXm_queue_in] = (XEvent *) malloc (sizeof(XEvent));
  847. +         *XXm_queue[XXm_queue_in] = event;
  848. +         XXm_queue_num++;
  849. +         XXm_queue_in = (XXm_queue_in + 1) % XMOUSEBUFSIZE;
  850. +         break;
  851. +     }
  852. +     }
  853. + }
  854. + 
  855. + XTinit_vms_input(input_ef)
  856. +     unsigned long input_ef;
  857. + {
  858. +     XSelectAsyncInput (XXdisplay, XXwindow,
  859. +                        KeyPressMask | ExposureMask | ButtonPressMask |
  860. +                        ButtonReleaseMask | EnterWindowMask |
  861. +                FocusChangeMask |
  862. +                        LeaveWindowMask | StructureNotifyMask,
  863. +                        input_ast, input_ef);
  864. + } /* XTinit_vms_input */
  865. + 
  866. + XTdiscard_input () {
  867. + }
  868. + 
  869. + static void solid_cursor() {
  870. +     CursorToggle ();
  871. +     CursorOutline = 0;
  872. +     CursorToggle ();
  873. + }
  874. + 
  875. + static void hollow_cursor() {
  876. +     CursorToggle ();
  877. +     CursorOutline = 1;
  878. +     CursorToggle ();
  879. + }
  880. + 
  881. + XTprocess_window_events() {
  882. +     int rows, cols;
  883. +     XEvent event;
  884. +     static int focus = 0;
  885. + 
  886. +     while (XCheckMaskEvent (XXdisplay, ExposureMask | EnterWindowMask |
  887. +                 LeaveWindowMask | StructureNotifyMask |
  888. +                 FocusChangeMask, &event))
  889. +     {
  890. +     event.type &= 0177;        /* Mask out XSendEvent indication */
  891. + 
  892. +     switch (event.type) {
  893. +       case NoExpose:
  894. +       default:                                                       break;
  895. +       case MappingNotify:     XRefreshKeyboardMapping(&event);       break;
  896. +       case MapNotify:         WindowMapped = 1;                      break;
  897. +       case UnmapNotify:       WindowMapped = 0;                      break;
  898. +       case EnterNotify:       if (!focus) solid_cursor ();           break;
  899. +       case LeaveNotify:       if (!focus) hollow_cursor ();          break;
  900. +       case FocusIn:           solid_cursor ();  focus = 1;           break;
  901. +       case FocusOut:          hollow_cursor (); focus = 1;           break;
  902. + 
  903. +       case ConfigureNotify:
  904. +         if (abs (pixelheight - event.xconfigure.height) < XXfonth &&
  905. +         abs (pixelwidth  - event.xconfigure.width) <  XXfontw)
  906. +         break;
  907. + 
  908. +         configure_pending = 1;
  909. + 
  910. +         rows = (event.xconfigure.height - 2 * XXInternalBorder) / XXfonth;
  911. +         cols = (event.xconfigure.width  - 2 * XXInternalBorder) / XXfontw;
  912. +         pixelwidth = cols * XXfontw + 2 * XXInternalBorder;
  913. +         pixelheight = rows * XXfonth + 2 * XXInternalBorder;
  914. +         break;
  915. + 
  916. +       case Expose:
  917. +         if (configure_pending) {
  918. +           int width, height;
  919. +           if (event.xexpose.count)
  920. +         break;
  921. +           /* This is absolutely, amazingly gross.
  922. +            * However, without it, emacs will core
  923. +            * dump if the window gets too small.  And
  924. +            * uwm is too brain-damaged to handle
  925. +            * large minimum size windows. */
  926. +           width = (pixelwidth-2*XXInternalBorder)/XXfontw;
  927. +           height = (pixelheight-2*XXInternalBorder)/XXfonth;
  928. +           if (width > 11 && height > 4)
  929. +               change_screen_size (height, width, 0);
  930. +           dumprectangle (0,0,pixelheight,pixelwidth);
  931. +           configure_pending = 0;
  932. +           break;
  933. +         }
  934. +         dumprectangle (event.xexpose.y-XXInternalBorder,
  935. +                event.xexpose.x-XXInternalBorder,
  936. +                event.xexpose.height,
  937. +                event.xexpose.width);
  938. +         break;
  939. + 
  940. +       case GraphicsExpose:
  941. +         dumprectangle (event.xgraphicsexpose.y-XXInternalBorder,
  942. +                event.xgraphicsexpose.x-XXInternalBorder,
  943. +                event.xgraphicsexpose.height,
  944. +                event.xgraphicsexpose.width);
  945. +         break;
  946. +     }
  947. +     }
  948. + }
  949. + 
  950. + #endif /* VMS */
  951.   
  952.   #endif /* HAVE_X_WINDOWS */
  953.   
  954. *** unixsrc/x11term.h    Tue Dec  6 18:30:18 1988
  955. --- vmssrc/x11term.h    Tue Dec  6 18:34:56 1988
  956. ***************
  957. *** 3,9 ****
  958. --- 3,11 ----
  959.   #include <X11/keysym.h>
  960.   #include <X11/cursorfont.h>
  961.   #include <X11/Xutil.h>
  962. + #ifndef VMS /* --- This is not needed - Joshua Marantz, 11/1/88 --- */
  963.   #include <X11/X10.h>
  964. + #endif
  965.   
  966.   #define XMOUSEBUFSIZE 64
  967.   
  968. *** unixsrc/s-vms.h    Tue Dec  6 18:30:25 1988
  969. --- vmssrc/s-vms.h    Mon Nov 28 15:23:40 1988
  970. ***************
  971. *** 140,146 ****
  972.      shared library, define this and remake xmakefile and fileio.c. This allows
  973.      us to ship a guaranteed executable image. */
  974.   
  975. ! /* #define LINK_CRTL_SHARE */
  976.   
  977.   /* Define this if you want to read the file SYS$SYSTEM:SYSUAF.DAT for user
  978.      information.  If you do use this, you must either make SYSUAF.DAT world 
  979. --- 140,146 ----
  980.      shared library, define this and remake xmakefile and fileio.c. This allows
  981.      us to ship a guaranteed executable image. */
  982.   
  983. ! #define LINK_CRTL_SHARE
  984.   
  985.   /* Define this if you want to read the file SYS$SYSTEM:SYSUAF.DAT for user
  986.      information.  If you do use this, you must either make SYSUAF.DAT world 
  987. ***************
  988. *** 223,229 ****
  989.   { 0, 50, 75, 110, 134, 150, 300, 600, 1200, 1800, \
  990.     2000, 2400, 3600, 4800, 7200, 9600, 19200 }
  991.   
  992. ! #define PURESIZE 132000
  993.   
  994.   /* Stdio FILE type has extra indirect on VMS, so must alter this macro.  */
  995.   
  996. --- 223,232 ----
  997.   { 0, 50, 75, 110, 134, 150, 300, 600, 1200, 1800, \
  998.     2000, 2400, 3600, 4800, 7200, 9600, 19200 }
  999.   
  1000. ! /* --------Added by Joshua Marantz, Viewlogic Systems Inc, 11/1/88-------- */
  1001. ! #define PURESIZE 136000     /* For x windows */
  1002. ! /* #define PURESIZE 132000 */
  1003. ! 
  1004.   
  1005.   /* Stdio FILE type has extra indirect on VMS, so must alter this macro.  */
  1006.   
  1007. *** unixsrc/config.h    Tue Dec  6 18:30:08 1988
  1008. --- vmssrc/config.h    Mon Nov 28 15:23:39 1988
  1009. ***************
  1010. *** 24,30 ****
  1011.      See the file ../etc/MACHINES for a list of systems and
  1012.      the names of the s- files to use for them.
  1013.      See s-template.h for documentation on writing s- files.  */
  1014. ! #include "s-bsd4-2.h"
  1015.   
  1016.   /* Include here a m- file that describes the machine and system you use.
  1017.      See the file ../etc/MACHINES for a list of machines and
  1018. --- 24,30 ----
  1019.      See the file ../etc/MACHINES for a list of systems and
  1020.      the names of the s- files to use for them.
  1021.      See s-template.h for documentation on writing s- files.  */
  1022. ! #include "s-vms4-4.h"
  1023.   
  1024.   /* Include here a m- file that describes the machine and system you use.
  1025.      See the file ../etc/MACHINES for a list of machines and
  1026. ***************
  1027. *** 31,37 ****
  1028.      the names of the m- files to use for them.
  1029.      See m-template.h for info on what m- files should define.
  1030.      */
  1031. ! #include "m-sun3.h"
  1032.   
  1033.   /* Load in the conversion definitions if this system
  1034.      needs them and the source file being compiled has not
  1035. --- 31,37 ----
  1036.      the names of the m- files to use for them.
  1037.      See m-template.h for info on what m- files should define.
  1038.      */
  1039. ! #include "m-vax.h"
  1040.   
  1041.   /* Load in the conversion definitions if this system
  1042.      needs them and the source file being compiled has not
  1043. ***************
  1044. *** 57,63 ****
  1045.      This appears to work on some machines that support X
  1046.      and not on others.  */
  1047.   
  1048. ! #define HAVE_X_MENU
  1049.   
  1050.   /* Define `subprocesses' should be defined if you want to
  1051.      have code for asynchronous subprocesses
  1052. --- 57,63 ----
  1053.      This appears to work on some machines that support X
  1054.      and not on others.  */
  1055.   
  1056. ! /* #define HAVE_X_MENU */
  1057.   
  1058.   /* Define `subprocesses' should be defined if you want to
  1059.      have code for asynchronous subprocesses
  1060.  
  1061. *** unixsrc/temacs.opt    Tue Dec  6 20:30:00 1988
  1062. --- vmssrc/temacs.opt    Mon Nov 28 15:24:14 1988
  1063. ***************
  1064. *** 46,51 ****
  1065. --- 46,53 ----
  1066.   tparam.obj,-
  1067.   lastfile.obj,-
  1068.   alloca.obj,-
  1069. + x11term.obj,-
  1070. + x11fns.obj,-
  1071.   malloc.obj
  1072.   collect=non_saved_data,-
  1073.   stdin,-
  1074. ***************
  1075. *** 56,59 ****
  1076.   sys_errlist,-
  1077.   sys_nerr,-
  1078.   environ
  1079. ! sys$library:vaxcrtl/library
  1080. --- 58,62 ----
  1081.   sys_errlist,-
  1082.   sys_nerr,-
  1083.   environ
  1084. ! sys$share:decw$xlibshr/share
  1085. ! sys$library:vaxcrtl/lib
  1086. *** unixsrc/compile.com    Tue Dec  6 20:30:06 1988
  1087. --- vmssrc/compile.com    Tue Dec  6 20:28:11 1988
  1088. ***************
  1089. *** 60,62 ****
  1090. --- 60,64 ----
  1091.   $    @recomp lastfile.c
  1092.   $    @recomp malloc.c
  1093.   $    @recomp alloca.c
  1094. + $    @recomp x11term.c
  1095. + $    @recomp x11fns.c
  1096.  
  1097. ----------------------End of vmsemacs.dif---------------------------------
  1098. -----------------------paste into lisp/direx.el--------------------------------
  1099. ; From: tbl@k.cs.cmu.edu (Thomas Lord)
  1100. ; Newsgroups: comp.emacs
  1101. ; Subject: a dired replacement for GNU
  1102. ; Date: 24 Mar 87 23:41:00 GMT
  1103. ; Organization: Carnegie-Mellon University, CS/RI
  1104. ; Posting-Front-End: GNU Emacs 18.36.5 of Sat Feb 14 1987 on k.cs.cmu.edu (berkeley-unix)
  1105. ; 
  1106. ; 
  1107. ; <I came in late...what's all this about a ...line eater?>
  1108. ; 
  1109. ; Below is Direx.el, my replacement for dired.  Since Direx works without
  1110. ; running ls it should be considerably faster on most systems.  There is a
  1111. ; trade off, however.  By default, direx uses a short style directory
  1112. ; listing.  That is, each file is listed by name only (no size,
  1113. ; protection, owner etc).  To get that extra information you must
  1114. ; explicitly call direx-fake-ls (bound to "l" by default).  
  1115. ; 
  1116. ; To invoke direx on some directory type M-x direx.  You will be
  1117. ; prompted for the directory name.
  1118. ; 
  1119. ; 
  1120. ; Direx mode is a superset of dired mode. In addition to the usual
  1121. ; commands the following exist:
  1122. ; 
  1123. ; direx-alternate-file : kill the current buffer and find the file
  1124. ; pointed to.  If that file is in fact a directory, then direx it.
  1125. ; This is normally bound to "j".  It is very usefull for bopping up and
  1126. ; down directory trees.
  1127. ; 
  1128. ; direx-expand-subdirectory : add the contents of a subdirectory to a
  1129. ; direx buffer.  Bound to "s".
  1130. ; 
  1131. ; direx-fake-ls : use the long listing format.  bound to "l"
  1132. ; 
  1133. ; There may still be bugs, particularly with features that don't get
  1134. ; much exercize locally (such as direx-clean-directory).  Please mail me
  1135. ; reports of any you find.
  1136. ; 
  1137. ; If you get to like direx (and I hope you will) you may wish to make
  1138. ; the following bindings:
  1139. ; 
  1140. ; (global-set-key "\C-x\C-f" 'direx-file)
  1141. ; (global-set-key "\C-x\C-v" 'direx-alternate-file)
  1142. ; (global-set-key "\C-x4f"   'direx-file-other-window)
  1143. ; 
  1144. ; 
  1145. ; Have fun!
  1146. ; 
  1147. ; Thomas Lord
  1148. ;  lord@andrew.cmu.edu            <----- prefered
  1149. ;  tbl@k.cs.cmu.edu
  1150. ; 
  1151. ; ------ cut here and store in direx.el --------
  1152.  
  1153. ;; DIREX commands for Emacs
  1154. ;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
  1155.  
  1156. ;; This file is part of GNU Emacs.
  1157.  
  1158. ;; GNU Emacs is distributed in the hope that it will be useful,
  1159. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  1160. ;; accepts responsibility to anyone for the consequences of using it
  1161. ;; or for whether it serves any particular purpose or works at all,
  1162. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  1163. ;; License for full details.
  1164.  
  1165. ;; Everyone is granted permission to copy, modify and redistribute
  1166. ;; GNU Emacs, but only under the conditions described in the
  1167. ;; GNU Emacs General Public License.   A copy of this license is
  1168. ;; supposed to have been given to you along with GNU Emacs so you
  1169. ;; can know your rights and responsibilities.  It should be in a
  1170. ;; file named COPYING.  Among other things, the copyright notice
  1171. ;; and this notice must be preserved on all copies.
  1172. ;;
  1173. ;;
  1174. ;; TODO
  1175.  
  1176.  
  1177. ;; add sorting : involves changes to direx-show-directory-fast,
  1178. ;;               direx-add-entry, direx-move-to-file-name 
  1179. ;;               direx-before-file-name, direx-file-name,
  1180. ;;               direx-expand-subdirectory, and direx-fake-ls but
  1181. ;;               should be very straight-forward 
  1182. ;; add dates to direx-fake-ls :
  1183. ;;               involves addition of a lisp call to ctime in the 
  1184. ;;               gnu-emacs c source 
  1185. ;;
  1186. ;; add mode changing stuff : very easy.  maybe *i*'ll do it.  
  1187. ;; add better support for expanding subdirectories in situ...like
  1188. ;;               maybe getting rid of expandes subdirectories 
  1189. ;;
  1190. ;; -------Made VMS-portable by Joshua Marantz, Viewlogic Systems Inc, 11/1/88
  1191. ;;  This module depends on the new time-string function, written in C, in
  1192. ;;  dired.c:
  1193. ;;
  1194. ;;DEFUN ("time-string", Ftime_string, Stime_string, 1, 1, 0,
  1195. ;;  "Convert TIME-LIST, which is a list of the high-order and\n\
  1196. ;;low-order bytes of a Unix time value, to a string.")
  1197. ;;  (time_list)
  1198. ;;    Lisp_Object time_list;
  1199. ;;{
  1200. ;;    Lisp_Object s;
  1201. ;;    long time_val, high, low;
  1202. ;;    char *temp;
  1203. ;;
  1204. ;;    s = Fcar (time_list);          CHECK_NUMBER (s, 3);  high = XFASTINT (s);
  1205. ;;    s = Fcar (Fcdr (time_list));   CHECK_NUMBER (s, 3);  low =  XFASTINT (s);
  1206. ;;    time_val = (high << 16) | low;
  1207. ;;    temp = (char *) ctime (&time_val);
  1208. ;;    return (build_string (temp));
  1209. ;;}
  1210. ;;
  1211. ;; Someone should really write a uid-to-uname function for VMS, and should
  1212. ;; write a lisp function to shorten the result of time-string a la unix
  1213. ;; "ls -l".  Essentially, it drops the year if it is this year, and drops
  1214. ;; the hour/minute/second info for other years.
  1215.  
  1216.  
  1217. (defun vms-p () (string= system-type 'vax-vms))
  1218.  
  1219. (defun name-around-point ()
  1220.   "Return the whitespace delimitted text under the point."
  1221.   (save-excursion
  1222.     (buffer-substring (progn (re-search-backward "[ \t^]")
  1223.                  (forward-char 1)
  1224.                  (point))
  1225.               (progn (re-search-forward  "[ \t\n%]")
  1226.                  (forward-char -1)
  1227.                  (point)))))
  1228.  
  1229.  
  1230.  
  1231. (defun repeat (n exp)
  1232.   "N times, eval EXP.  Repeat once if N is nil."
  1233.   (let ( (count (or n 1)) )
  1234.     (while (> count 0)
  1235.       (eval exp)
  1236.       (setq count (1- count)))))
  1237.  
  1238.  
  1239. (defvar direx-use-long-directory nil
  1240.   "*If this is non-nil, direx mode will always use a long directory format.")
  1241.  
  1242. (defvar direx-indicate-directories nil
  1243.   "*If non-nil, short direx listings have % after directory names. (Slower)")
  1244.  
  1245.  
  1246. (defun direx-show-directory-fast (directory &optional prefix)
  1247.   "Insert at the point a brief listing of DIRECTORY."
  1248.   (let* ( (buffer-read-only nil)
  1249.       (prefix (or prefix ""))
  1250.       (expanded-name (directory-file-name (expand-file-name directory)))
  1251.       (attributes    (file-attributes expanded-name)) )
  1252.     (cond ( (stringp (car attributes))
  1253.         (direx-show-directory-fast (car attributes)) )
  1254.       ( (not (car attributes))
  1255.         (error "%s is not a directory!" directory) )
  1256.       ( t
  1257.         (or (bolp)
  1258.         (insert "\n"))
  1259.         (let ( (start (point))
  1260.            (file-list (directory-files directory nil nil)) )
  1261.           (while file-list
  1262.         (let ( (fname (car file-list)) )
  1263.           (insert "  "
  1264.               prefix
  1265.               fname
  1266.               (if (and direx-indicate-directories
  1267.                    (file-directory-p fname))
  1268.                   "%"
  1269.                 "")
  1270.               "\n")
  1271.           (setq file-list (cdr file-list))))
  1272.           (if (or ls-done direx-use-long-directory)
  1273.           (let ( (ls-done nil) )
  1274.             (direx-fake-ls start (1- (point))))))
  1275.         (delete-blank-lines) ))))
  1276.  
  1277.  
  1278. (defun direx-add-entry (directory name)
  1279.   "  Add an entry for file name if it is in a subdirectory of the
  1280.   defualt directory. This will fail if directory is made up of links.
  1281.   Right now, we are so lazy that we do not bother to sort."
  1282.     (if (= 0 (string-match (expand-file-name default-directory)
  1283.               (expand-file-name directory)))
  1284.       (let ( (buffer-read-only nil)
  1285.          (relative-directory
  1286.           (substring directory (match-end 0) (length directory)))
  1287.          (ls-was-done ls-done)
  1288.          (ls-done nil)
  1289.          (start (point)) )
  1290.     (if (not (= (point) (point-min)))
  1291.         (insert "\n"))
  1292.     (insert "  " relative-directory name)
  1293.     (if ls-was-done
  1294.         (direx-fake-ls start (point)))
  1295.     (direx-before-file-name))))
  1296.  
  1297.  
  1298.  
  1299. (defun direx-move-to-file-name ()
  1300.   "Move to the file name field in a direx buffer."
  1301.   (end-of-line))
  1302.  
  1303. (defun direx-before-file-name ()
  1304.   "Move the point before a file name."
  1305.   (direx-move-to-file-name)
  1306.   (skip-chars-backward "^ \n\t"))
  1307.  
  1308. (defun direx-file-name ()
  1309.   "Return the name of the file on this line."
  1310.   (save-excursion
  1311.     (direx-move-to-file-name)
  1312.     (let ( (name (name-around-point)) )
  1313.       (if (string= name "")
  1314.       (error "No file on this line.")
  1315.     name))))
  1316.  
  1317. (defun direx-expand-subdirectory ()
  1318.   "Insert the subdirectory for the current file in a direx buffer."
  1319.   (interactive)
  1320.   (direx-move-to-file-name)
  1321.   (let ( (buffer-read-only nil)
  1322.      (name  (direx-file-name))
  1323.       (start (point)) )
  1324.     (end-of-line 1)
  1325.     (direx-show-directory-fast
  1326.      (file-name-as-directory
  1327.       (concat default-directory name)))
  1328.     (goto-char start)
  1329.     (direx-next-line)))
  1330.  
  1331. (if (vms-p)
  1332.     (progn
  1333.       (defun vms-remove-colon (name)
  1334.     (if (string= ":" (substring name -1))
  1335.         (substring name 0 -1)
  1336.       name))
  1337.  
  1338.       (defun vms-remove-000000 (name)
  1339.     (let ((start-zeros (string-match "000000\\." name)))
  1340.       (if start-zeros
  1341.           (concat (substring name 0 start-zeros)
  1342.               (substring name (+ start-zeros 7)))
  1343.         name)))
  1344.  
  1345.       (defun vms-eval-logical (name)
  1346.     (let* ((upname  (upcase name))
  1347.            (nocolon (vms-remove-colon upname))
  1348.            (translation (getenv nocolon)))
  1349.       (if translation
  1350.           (vms-eval-logical translation)
  1351.         (vms-remove-000000 upname))))))
  1352.  
  1353. (defun direx (directory)
  1354.   "Make a buffer for directory and direx in it."
  1355.   (interactive "DDirectory: ")
  1356.   (let* ( (ex-name (file-name-as-directory (expand-file-name directory)))
  1357.       (dir     (if (vms-p) (vms-eval-logical ex-name) ex-name))
  1358.       (buffer  (get-buffer-create dir)) )
  1359.     (switch-to-buffer buffer)
  1360.     (let ( (buffer-read-only nil) )
  1361.       (erase-buffer)
  1362.       (setq buffer-read-only t)
  1363.       (setq default-directory dir)
  1364.       (make-local-variable 'ls-done)
  1365.       (setq ls-done nil)
  1366.       (direx-show-directory-fast default-directory)
  1367.       (goto-char (point-min))
  1368.       (direx-before-file-name)
  1369.       (direx-mode dir)
  1370.       (set-buffer-modified-p nil))
  1371.     (setq buffer-read-only t)))
  1372.  
  1373.  
  1374. (defun direx-file (file)
  1375.   "Find the file FILE unless it is a directory.  If it is a directory,
  1376.    direx it."
  1377.   (interactive "FFile: ")
  1378.   (let ( (attributes (file-attributes file)) )
  1379.     (cond ( (eq (car attributes) t)
  1380.         (direx (expand-file-name file)) )
  1381.       ( (car attributes)
  1382.         (direx-file (car attributes)) )
  1383.       ( t
  1384.         (find-file file) ))))
  1385.       
  1386. (defun direx-alternate-file (file)
  1387.   "Visit the file FILE unless it is a directory.  If it is a directory,
  1388.    direx it. Kills the current buffer."
  1389.   (interactive "FFile: ")
  1390.   (let ( (attributes (file-attributes file))
  1391.      (full-name (expand-file-name file)) )
  1392.     (cond ( (eq (car attributes) t)
  1393.         (kill-buffer (current-buffer)) 
  1394.         (direx full-name) )
  1395.       ( (car attributes)
  1396.         (direx-alternate-file (car attributes)) )
  1397.       ( t (find-alternate-file file) ))))
  1398.  
  1399.  
  1400.  
  1401. (if (vms-p)
  1402.     (defun uid-to-uname (uid) uid)
  1403.   (progn
  1404.     (defvar uid-cache '(("-1"."paranoid"))
  1405.       "  A cache for argument-value pairs from uid-to-uname.")
  1406.  
  1407.     (defun password-buffer ()
  1408.       "Return the buffer *passwd* which hopefully contains the passwd file."
  1409.       (or (get-buffer "*passwd*")
  1410.       (save-excursion
  1411.         (switch-to-buffer (get-buffer-create "*passwd*"))
  1412.         (insert-file "/etc/passwd")
  1413.         (current-buffer))))
  1414.  
  1415.  
  1416.     (defun uid-to-uname (uid)
  1417.       "  Convert a user id to a user name.  We assume we can lay claim to a
  1418. buffer named *passwd*."
  1419.       (or (cdr (assoc uid uid-cache))
  1420.       (let ( (pwbuff (password-buffer)) )
  1421.         (save-excursion
  1422.           (switch-to-buffer pwbuff)
  1423.           (goto-char (point-min))
  1424.           (let* ((uid-string (concat ":" uid ":"))
  1425.              (pwstring (format "^\\([^:\n]*\\):[^:\n]*%s" uid-string)))
  1426.         (catch 'no-such-uid
  1427.           (while (not (looking-at pwstring))
  1428.             (if (not (search-forward uid-string nil t))
  1429.             (throw 'no-such-uid uid))
  1430.             (beginning-of-line))
  1431.           (let ((uname
  1432.              (buffer-substring (match-beginning 1) (match-end 1))))
  1433.             (setq uid-cache (cons (cons uid uname) uid-cache))
  1434.             (bury-buffer (current-buffer))
  1435.             uname)))))))))
  1436.  
  1437. (defun direx-fake-ls (&optional start end)
  1438.   "  The current buffer should consist of lines of file names.
  1439.    direx-fake-ls makes it look like they were put there by ls -l.
  1440.    Optional parameters START and END bound the action of direx-fake-ls"
  1441.   (interactive)
  1442.   (if ls-done
  1443.       nil
  1444.     (save-excursion
  1445.       (let ( (buffer-read-only nil)
  1446.          (bottom (or end (point-max)))
  1447.          (top (or start (point-min))) )
  1448.     (goto-char (1- bottom))
  1449.     (while (>= (point) top)
  1450.       (let ( (attributes
  1451.           (or (file-attributes (direx-file-name))
  1452.               '(() -1 -1 () () () () "???" "-barf!-"))) )
  1453.         (beginning-of-line)
  1454.         (if (= (point) top) (setq top (point-max)))
  1455.         (direx-before-file-name)
  1456.         (let ( (access (nth 8 attributes))
  1457.            (links  (concat (nth 1 attributes)))
  1458.            (uid    (concat (nth 2 attributes)))
  1459.            (date   (nth 5 attributes))
  1460.            (size   (concat (nth 7 attributes))) )
  1461.           (insert access)
  1462.           (indent-to-column (- 20 (length links)))
  1463.           (if (vms-p)
  1464.           (progn (insert (time-string date)) (backward-delete-char 1))
  1465.         (insert links " " (uid-to-uname uid)))
  1466.           (indent-to-column (- 50 (length size)))
  1467.           (insert size "  ")
  1468.           (direx-previous-line))))
  1469.     (setq ls-done t)))
  1470.     (direx-before-file-name)))
  1471.  
  1472. (defun direx-next-line (&optional count)
  1473.   "Move to the file name on the next line.  With ARG, move that many lines."
  1474.   (interactive "p")
  1475.   (let ( (n (or count 1)) )
  1476.     (forward-line n)
  1477.     (direx-before-file-name)))
  1478.  
  1479. (defun direx-previous-line (&optional count)
  1480.   "Move to the file name on the previous line. 
  1481.    With ARG, move that many lines."
  1482.   (interactive "p")
  1483.   (let ( (n (or count 1)) )
  1484.     (direx-next-line (- n))))
  1485.  
  1486. (defun direx-set-deletion-field (value)
  1487.   "Put the char VALUE in the deletion field of the current line.
  1488.    Signal an error if there is no file on this line.
  1489.    Do nothing if the file on this line is a directory."
  1490.   (let* ( (name (direx-file-name))
  1491.       (buffer-read-only nil)
  1492.       (attributes (file-attributes name)) )
  1493.     (or (eq (car attributes) t)
  1494.       (progn
  1495.     (beginning-of-line 1)
  1496.     (delete-char 1)
  1497.     (insert value)
  1498.     (direx-before-file-name)))))
  1499.  
  1500.  
  1501. (defun direx-flag-file-deleted (&optional count)
  1502.   "Mark a file for deletion."
  1503.   (interactive "p")
  1504.   (repeat count
  1505.       '(progn
  1506.          (direx-set-deletion-field "D")
  1507.          (direx-next-line))))
  1508.  
  1509. (defun direx-unflag (&optional count)
  1510.   "Unmark a bunch of files."
  1511.   (interactive "p")
  1512.   (repeat count
  1513.       '(progn
  1514.          (direx-set-deletion-field " ")
  1515.          (direx-next-line))))
  1516.  
  1517. (defun direx-backup-unflag (&optional count)
  1518.   "Unmark a bunch of files moving backwards."
  1519.   (interactive "p")
  1520.   (repeat count
  1521.       '(progn
  1522.          (direx-previous-line)
  1523.          (direx-set-deletion-field " "))))
  1524.  
  1525. (defun direx-file-marked-p ()
  1526.   "Return t if the current line has a deletion mark."
  1527.   (save-excursion
  1528.     (beginning-of-line 1)
  1529.     (looking-at "D ")))
  1530.  
  1531. (defun direx-revert (&optional arg noconfirm)
  1532.   "Revert a direx buffer."
  1533.   (interactive)
  1534.   (let ( (buffer-read-only nil) )
  1535.     (erase-buffer)
  1536.     (direx-show-directory-fast default-directory)
  1537.     (beginning-of-buffer)
  1538.     (direx-before-file-name)))
  1539.  
  1540.  
  1541. (defun direx-file-other-window (file)
  1542.   "Direx FILE in another window."
  1543.   (interactive "FFile:")
  1544.   (let ( (expanded-name (expand-file-name file)) )
  1545.     (other-window 1)
  1546.     (direx-file expanded-name)))
  1547.  
  1548.  
  1549. (defun direx-view-file (file)
  1550.   "Find FILE in view mode.  If FILE is a directory, direx it instead."
  1551.   (interactive "fFile: ")
  1552.   (let ( (attributes (file-attributes file)) )
  1553.     (cond ( (eq (car attributes) t)
  1554.         (direx (expand-file-name file)) )
  1555.       ( (car attributes)
  1556.         (direx-view-file (car-attributes)) )
  1557.       ( t
  1558.         (view-file file) ))))
  1559.  
  1560.  
  1561. (defun direx-find-this ()
  1562.   "Direx interaction for direx-file."
  1563.   (interactive)
  1564.   (direx-file (direx-file-name)))
  1565.  
  1566. (defun direx-alternate-this ()
  1567.   "Direx interaction for direx-alternate-file."
  1568.   (interactive)
  1569.   (direx-alternate-file (direx-file-name)))
  1570.  
  1571. (defun direx-view-this ()
  1572.   "Direx interaction for direx-view-file."
  1573.   (interactive)
  1574.   (direx-view-file (direx-file-name)))
  1575.  
  1576. (defun direx-this-other-window ()
  1577.   "Direx interaction for direx-file-other-window."
  1578.   (interactive)
  1579.   (direx-file-other-window (direx-file-name)))
  1580.  
  1581. (defun direx-rename-file (to-file)
  1582.   "Rename this file to TO-FILE."
  1583.   (interactive "FRename to: ")
  1584.   (setq to-file (expand-file-name to-file))
  1585.   (rename-file (expand-file-name (direx-file-name)) to-file)
  1586.   (let ((buffer-read-only nil))
  1587.     (beginning-of-line)
  1588.     (delete-region (point) (progn (forward-line 1) (point)))
  1589.     (end-of-line 0)
  1590.     (setq to-file (expand-file-name to-file))
  1591.     (direx-add-entry (file-name-directory to-file)
  1592.              (file-name-nondirectory to-file))))
  1593.  
  1594.   
  1595. (defun direx-do-deletions ()
  1596.   "In direx, delete the files flagged for deletion."
  1597.   (interactive)
  1598.   (let (delete-list answer)
  1599.     (save-excursion
  1600.      (goto-char 1)
  1601.      (while (re-search-forward "^D" nil t)
  1602.        (setq delete-list
  1603.          (cons (cons (direx-file-name) (1- (point)))
  1604.            delete-list))))
  1605.     (if (null delete-list)
  1606.     (message "(No deletions requested)")
  1607.       (save-window-excursion
  1608.        (switch-to-buffer " *Deletions*")
  1609.        (erase-buffer)
  1610.        (setq fill-column (- (window-width) 10))
  1611.        (let ((l (reverse delete-list)))
  1612.          ;; Files should be in forward order for this loop.
  1613.      (while l
  1614.        (if (> (current-column) (- (window-width) 21))
  1615.            (insert ?\n)
  1616.          (or (bobp)
  1617.          (indent-to (* (/ (+ (current-column) 19) 20) 20) 1)))
  1618.        (insert (car (car l)))
  1619.        (setq l (cdr l))))
  1620.        (goto-char (point-min))
  1621.        (setq answer (yes-or-no-p "Delete these files? ")))
  1622.       (if answer
  1623.       (let ((l delete-list)
  1624.         failures)
  1625.         ;; Files better be in reverse order for this loop!
  1626.         ;; That way as changes are made in the buffer
  1627.         ;; they do not shift the lines still to be changed.
  1628.         (while l
  1629.           (goto-char (cdr (car l)))
  1630.           (let ((buffer-read-only nil))
  1631.         (condition-case ()
  1632.             (progn (delete-file (concat default-directory
  1633.                         (car (car l))))
  1634.                (message (concat default-directory (car (car l))))
  1635.                (delete-region (progn (beginning-of-line) (point))
  1636.                       (progn (forward-line 1) (point))))
  1637.           (error (delete-char 1)
  1638.              (insert " ")
  1639.              (setq failures (cons (car (car l)) failures)))))
  1640.           (setq l (cdr l)))
  1641.         (if failures
  1642.         (message "Deletions failed: %s"
  1643.              (prin1-to-string failures))
  1644.           (set-buffer-modified-p nil))
  1645.         (direx-before-file-name))))))
  1646.  
  1647.  
  1648. (defun direx-copy-file (to-file)
  1649.   "Copy this file to TO-FILE."
  1650.   (interactive "FCopy to: ")
  1651.   (copy-file (direx-file-name) to-file)
  1652.   (setq to-file (expand-file-name to-file))
  1653.   (end-of-line)
  1654.   (direx-add-entry (file-name-directory to-file)
  1655.            (file-name-nondirectory to-file)))
  1656.   
  1657.  
  1658. (defun direx-flag-auto-save-files ()
  1659.   "Flag for deletion files whose names suggest they are auto save files."
  1660.   (interactive)
  1661.   (save-excursion
  1662.    (let ((buffer-read-only nil))
  1663.      (goto-char (point-min))
  1664.      (while (not (eobp))
  1665.        (and (not (eolp))
  1666.         (if (fboundp 'auto-save-file-name-p)
  1667.         (let ((fn (direx-file-name)))
  1668.           (if fn (auto-save-file-name-p fn)))
  1669.           (if (direx-before-filename)
  1670.           (looking-at "#")))
  1671.         (direx-set-deletion-field "D"))
  1672.        (forward-line 1)))))
  1673.  
  1674.  
  1675. (defun direx-flag-backup-files ()
  1676.   "Flag all backup files (names ending with ~) for deletion."
  1677.   (interactive)
  1678.   (save-excursion
  1679.    (let ((buffer-read-only nil))
  1680.      (goto-char (point-min))
  1681.      (while (not (eobp))
  1682.        (and (not (eolp))
  1683.         (if (fboundp 'backup-file-name-p)
  1684.         (let ((fn (direx-file-name)))
  1685.           (if fn (backup-file-name-p fn)))
  1686.           (end-of-line)
  1687.           (forward-char -1)
  1688.           (looking-at "~"))
  1689.         (direx-set-deletion-field "D"))
  1690.        (forward-line 1)))))
  1691.  
  1692.  
  1693. (defconst direx-kept-versions 2
  1694.   "*When cleaning directory, number of versions to keep.")
  1695.  
  1696. (defun direx-clean-directory (keep)
  1697.   "  Flag numerical backups for Deletion.
  1698.   Spares dired-kept-versions latest versions, and kept-old-versions oldest.
  1699.   Positive numeric arg overrides dired-kept-versions;
  1700.   negative numeric arg overrides kept-old-versions with minus the arg."
  1701.   (interactive "P")
  1702.   (setq keep (if keep (prefix-numeric-value keep) direx-kept-versions))
  1703.   (let ((early-retention (if (< keep 0) (- keep) kept-old-versions))
  1704.     (late-retention (if (<= keep 0) direx-kept-versions keep))
  1705.     (file-version-assoc-list ()))
  1706.     ;; Look at each file.
  1707.     ;; If the file has numeric backup versions,
  1708.     ;; put on file-version-assoc-list an element of the form
  1709.     ;; (FILENAME . VERSION-NUMBER-LIST)
  1710.     (direx-map-direx-file-lines 'direx-collect-file-versions)
  1711.     ;; Sort each VERSION-NUMBER-LIST,
  1712.     ;; and remove the versions not to be deleted.
  1713.     (let ((fval file-version-assoc-list))
  1714.       (while fval
  1715.     (let* ((sorted-v-list (cons 'q (sort (cdr (car fval)) '<)))
  1716.            (v-count (length sorted-v-list)))
  1717.       (if (> v-count (+ early-retention late-retention))
  1718.           (rplacd (nthcdr early-retention sorted-v-list)
  1719.               (nthcdr (- v-count late-retention)
  1720.                   sorted-v-list)))
  1721.       (rplacd (car fval)
  1722.           (cdr sorted-v-list)))
  1723.     (setq fval (cdr fval)))) 
  1724.     ;; Look at each file.  If it is a numeric backup file,
  1725.     ;; find it in a VERSION-NUMBER-LIST and maybe flag it for deletion.
  1726.     (direx-map-direx-file-lines 'direx-trample-file-versions)))
  1727.  
  1728.  
  1729.  
  1730. (defun direx-collect-file-versions (ignore fn)
  1731.   "If it looks like fn has versions, we make a list of the versions.
  1732. We may want to flag some for deletion."
  1733.     (let* ((base-versions
  1734.         (concat (file-name-nondirectory fn) ".~"))
  1735.        (bv-length (length base-versions))
  1736.        (possibilities (file-name-all-completions
  1737.                base-versions
  1738.                (file-name-directory fn)))
  1739.        (versions (mapcar 'backup-extract-version possibilities)))
  1740.       (if versions
  1741.       (setq file-version-assoc-list (cons (cons fn versions)
  1742.                           file-version-assoc-list)))))
  1743.  
  1744. (defun direx-trample-file-versions (ignore fn)
  1745.   (let* ((start-vn (string-match "\\.~[0-9]+~$" fn))
  1746.      base-version-list)
  1747.     (and start-vn
  1748.      (setq base-version-list    ; there was a base version to which 
  1749.            (assoc (substring fn 0 start-vn)    ; this looks like a 
  1750.               file-version-assoc-list))    ; subversion
  1751.      (not (memq (string-to-int (substring fn (+ 2 start-vn)))
  1752.             base-version-list))    ; this one doesn't make the cut
  1753.      (direx-set-deletion-field "D"))))
  1754.  
  1755.  
  1756.  
  1757. (defun direx-map-direx-file-lines (fn)
  1758.   "perform fn with point at the end of each non-directory line:
  1759. arguments are the short and long filename"
  1760.   (save-excursion
  1761.     (let (filename longfilename (buffer-read-only nil))
  1762.       (goto-char (point-min))
  1763.       (while (not (eobp))
  1764.     (save-excursion
  1765.       (and (not (looking-at "  d"))
  1766.            (not (eolp))
  1767.            (setq filename (direx-file-name)
  1768.              longfilename (expand-file-name (direx-file-name)))
  1769.            (progn (end-of-line)
  1770.               (funcall fn filename longfilename))))
  1771.     (forward-line 1)))))
  1772.  
  1773.  
  1774.  
  1775. (defun direx-summary ()
  1776.   "Give the luser a summary of direx commands."
  1777.   (interactive)
  1778.   (message
  1779.    (substitute-command-keys
  1780.     "\\[direx-flag-file-deleted] delete, \\[direx-unflag] undelete, \\[direx-do-deletions] execute, \\[direx-find-this] find, \\[direx-alternate-this] jump")))
  1781.  
  1782.  
  1783.  
  1784. (defvar direx-mode-map nil "Local keymap for direx-mode buffers.")
  1785. (if direx-mode-map
  1786.     nil
  1787.   (setq direx-mode-map (make-keymap))
  1788.   (suppress-keymap direx-mode-map)
  1789.   (define-key direx-mode-map " "  'direx-next-line)
  1790.   (define-key direx-mode-map "#" 'direx-flag-auto-save-files)
  1791.   (define-key direx-mode-map "." 'direx-clean-directory)
  1792.   (define-key direx-mode-map "?" 'direx-summary)
  1793.   (define-key direx-mode-map "\C-?" 'direx-backup-unflag)
  1794.   (define-key direx-mode-map "\C-d" 'direx-flag-file-deleted)
  1795.   (define-key direx-mode-map "\C-n" 'direx-next-line)
  1796.   (define-key direx-mode-map "\C-p" 'direx-previous-line)
  1797.   (define-key direx-mode-map "c" 'direx-copy-file)
  1798.   (define-key direx-mode-map "d" 'direx-flag-file-deleted)
  1799.   (define-key direx-mode-map "e" 'direx-find-this)
  1800.   (define-key direx-mode-map "f" 'direx-find-this)
  1801.   (define-key direx-mode-map "g" 'revert-buffer)
  1802.   (define-key direx-mode-map "h" 'describe-mode)
  1803.   (define-key direx-mode-map "j" 'direx-alternate-this)
  1804.   (define-key direx-mode-map "l" 'direx-fake-ls)
  1805.   (define-key direx-mode-map "n" 'direx-next-line)
  1806.   (define-key direx-mode-map "o" 'direx-this-other-window)
  1807.   (define-key direx-mode-map "p" 'direx-previous-line)
  1808.   (define-key direx-mode-map "r" 'direx-rename-file)
  1809.   (define-key direx-mode-map "s" 'direx-expand-subdirectory)
  1810.   (define-key direx-mode-map "u" 'direx-unflag)
  1811.   (define-key direx-mode-map "v" 'direx-view-this)
  1812.   (define-key direx-mode-map "x" 'direx-do-deletions)
  1813.   (define-key direx-mode-map "~" 'direx-flag-backup-files))
  1814.  
  1815. ;; Direx mode is suitable only for specially formatted data.
  1816. (put 'direx-mode 'mode-class 'special)
  1817.  
  1818. (defun direx-mode (dirname)
  1819.   "Mode for \"editing\" directory listings.
  1820. In direx, you are \"editing\" a list of the files in a directory.
  1821. You can move using the usual cursor motion commands.
  1822. Letters no longer insert themselves.
  1823. Instead, type d to flag a file for Deletion.
  1824. Type u to Unflag a file (remove its D flag).
  1825.   Type Rubout to back up one line and unflag.
  1826. Type x to eXecute the deletions requested.
  1827. Type l to get a more informative directory listing.
  1828. Type f to Find the current line's file
  1829.   (or Direx it, if it is a directory).
  1830. Type o to find file or direx directory in Other window.
  1831. Type # to flag temporary files (names beginning with #) for Deletion.
  1832. Type ~ to flag backup files (names ending with ~) for Deletion.
  1833. Type . to flag numerical backups for Deletion.
  1834.   (Spares direx-kept-versions or its numeric argument.)
  1835. Type r to rename a file.
  1836. Type c to copy a file.
  1837. Type v to view a file in View mode, returning to Direx when done.
  1838. Type g to read the directory again.  This discards all deletion-flags.
  1839. Type j to direx-find this file in a buffer replacing the current buffer.
  1840. Type s to expand a subdirectory in place.
  1841. Type l to get a long directory listing for the files in the current buffer.
  1842. Space and Rubout can be used to move down and up by lines.
  1843. \\{direx-mode-map}"
  1844.   (kill-all-local-variables)    
  1845.   (make-local-variable 'revert-buffer-function)
  1846.   (setq revert-buffer-function 'direx-revert)
  1847.   (setq major-mode 'direx-mode)
  1848.   (setq mode-name "Direx")
  1849.   (make-local-variable 'ls-done)
  1850.   (setq default-directory dirname)
  1851.   (setq mode-line-buffer-identification '("Direx: %17b"))
  1852.   (setq case-fold-search (vms-p))
  1853.   (setq buffer-read-only t)
  1854.   (use-local-map direx-mode-map)
  1855.   (run-hooks 'direx-mode-hook))
  1856. -------------------------end of lisp/direx.el---------------------------
  1857.  
  1858. -- 
  1859. Mike Wexler(wyse!mikew)    Phone: (408)433-1000 x1330
  1860. Moderator of comp.sources.x
  1861.